home *** CD-ROM | disk | FTP | other *** search
/ The Atari Compendium / The Atari Compendium (Toad Computers) (1994).iso / files / prgtools / programm.ing / m2posx10.zoo / m2posix.10 / test / tlib.mpp < prev    next >
Encoding:
Text File  |  1993-10-15  |  24.1 KB  |  887 lines
  1. MODULE Tlib;
  2. __IMP_SWITCHES__
  3. #if (defined HM2) || (defined HM2_OLD)
  4. (*$E+ Prozeduren als Parameter moeglich *)
  5. #endif
  6. #ifdef HM2
  7. #ifdef __LONG_WHOLE__
  8. (*$!i+: Modul muss mit $i- uebersetzt werden! *)
  9. (*$!w+: Modul muss mit $w- uebersetzt werden! *)
  10. #else
  11. (*$!i-: Modul muss mit $i+ uebersetzt werden! *)
  12. (*$!w-: Modul muss mit $w+ uebersetzt werden! *)
  13. #endif
  14. #endif
  15. (* 06-Okt-93, hk *)
  16.  
  17. CAST_IMPORT
  18. VAL_INTRINSIC
  19. PTR_ARITH_IMPORT
  20. REGISTER_IMPORT
  21.  
  22. FROM SYSTEM IMPORT
  23. (* TYPE *) ADDRESS,
  24. (* PROC *) TSIZE, ADR;
  25.  
  26. FROM PORTAB IMPORT
  27. (* TYPE *) UNSIGNEDLONG, SIGNEDLONG, UNSIGNEDWORD, SIGNEDWORD;
  28.  
  29. FROM types IMPORT
  30. (* CONST*) NULL;
  31.  
  32. FROM pSTRING IMPORT
  33. (* PROC *) EQUAL;
  34.  
  35. FROM jump IMPORT
  36. (* TYPE *) JmpBuf,
  37. (* PROC *) setjmp, longjmp;
  38.  
  39. FROM lib IMPORT
  40. (* TYPE *) CompareProc,
  41. (* PROC *) lfind, bsearch, qsort, ltoa, ultoa, rand, strtol, strtoul;
  42.  
  43. FROM OSCALLS IMPORT
  44. (* PROC *) Malloc, Mfree;
  45.  
  46. FROM MEMBLK IMPORT
  47. (* PROC *) memswap, memmove, memset, memchr, memcmp, memalloc, memdealloc;
  48.  
  49. FROM InOut IMPORT
  50. (* PROC *) Read, Write, WriteInt, WriteString, WriteLn;
  51.  
  52. (*~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~*)
  53.  
  54. TYPE
  55.   FillProc = PROCEDURE(SIGNEDWORD,SIGNEDWORD): UNSIGNEDLONG;
  56.  
  57. CONST
  58.   BEFORE = 10;
  59.   AFTER  = 10;
  60.   MAXLEN = 100;
  61.  
  62. CONST
  63.   MINLINT  = 80000000H;
  64.   MAXLINT  = 7FFFFFFFH;
  65.   MAXLCARD = 0FFFFFFFFH;
  66.  
  67. CONST
  68.   CPATTERN = 377C;
  69.   LPATTERN = 5E5E5E5EH;
  70.   MAXCBUF  = 499;
  71.   MAXLBUF  = 299;
  72.  
  73. CONST
  74.   LONGJUMPVAL = 42;
  75.   GLOBALVAL   = 12345678H;
  76.   LOCALVAL    = 87654321H;
  77.  
  78. TYPE LBuf = ARRAY [0..MAXLBUF] OF UNSIGNEDLONG;
  79.      CBuf = ARRAY [0..MAXCBUF] OF CHAR;
  80.  
  81. VAR cbuf      : CBuf;
  82.     lbuf      : LBuf;
  83.     lbuf2     : LBuf;
  84.     test      : UNSIGNEDLONG;
  85.     found     : POINTER TO UNSIGNEDLONG;
  86.     i         : UNSIGNEDWORD;
  87.     BusyBuf   : ARRAY [0..4] OF CHAR;
  88.     BusyIdx   : [0..4];
  89.     ch        : CHAR;
  90.     ERROR     : BOOLEAN;
  91.     jmpbuf    : JmpBuf;
  92.     globalvar : UNSIGNEDLONG;
  93.  
  94. (*~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~*)
  95.  
  96. PROCEDURE OK (REF proc : ARRAY OF CHAR);
  97. BEGIN
  98.  IF NOT ERROR THEN
  99.    WriteString(proc); WriteString(": OK"); WriteLn;
  100.  END;
  101. END OK;
  102.  
  103. (*---------------------------------------------------------------------------*)
  104.  
  105. PROCEDURE Busy;
  106. BEGIN
  107.  Write(CHR(8));
  108.  Write(BusyBuf[BusyIdx]);
  109.  BusyIdx := (BusyIdx + 1) MOD 4;
  110. END Busy;
  111.  
  112. (*---------------------------------------------------------------------------*)
  113.  
  114. PROCEDURE ClearBusy;
  115. BEGIN
  116.  Write(CHR(8));
  117.  Write(' ');
  118.  Write(CHR(8));
  119. END ClearBusy;
  120.  
  121. (*---------------------------------------------------------------------------*)
  122.  
  123. PROCEDURE fillinc ((* EIN/ -- *) i   : SIGNEDWORD;
  124.                    (* EIN/ -- *) max : SIGNEDWORD ): UNSIGNEDLONG;
  125. BEGIN
  126.  RETURN(VAL(UNSIGNEDLONG,i));
  127. END fillinc;
  128.  
  129. (*---------------------------------------------------------------------------*)
  130.  
  131. PROCEDURE filldec ((* EIN/ -- *) i   : SIGNEDWORD;
  132.                    (* EIN/ -- *) max : SIGNEDWORD ): UNSIGNEDLONG;
  133. BEGIN
  134.  RETURN(VAL(UNSIGNEDLONG,max - i));
  135. END filldec;
  136.  
  137. (*---------------------------------------------------------------------------*)
  138.  
  139. PROCEDURE fillrnd ((* EIN/ -- *) i   : SIGNEDWORD;
  140.                    (* EIN/ -- *) max : SIGNEDWORD ): UNSIGNEDLONG;
  141. BEGIN
  142.  RETURN(rand());
  143. END fillrnd;
  144.  
  145. (*---------------------------------------------------------------------------*)
  146.  
  147. PROCEDURE cmp ((* EIN/ -- *) a : ADDRESS;
  148.                (* EIN/ -- *) b : ADDRESS ): INTEGER;
  149.  
  150. VAR __REG__ A , B : POINTER TO UNSIGNEDLONG;
  151. BEGIN
  152.  A := a;
  153.  B := b;
  154.  IF A^ > B^ THEN
  155.    RETURN(1);
  156.  ELSIF A^ < B^ THEN
  157.    RETURN(-1);
  158.  ELSE
  159.    RETURN(0);
  160.  END;
  161. END cmp;
  162.  
  163. (*---------------------------------------------------------------------------*)
  164.  
  165. PROCEDURE SlowSort ((* EIN/ -- *)     from : UNSIGNEDWORD;
  166.                     (* EIN/ -- *)     to   : UNSIGNEDWORD;
  167.                     (* EIN/AUS *) VAR buf  : ARRAY OF UNSIGNEDLONG );
  168. (* langsam, aber durchschaubar...zum testen von "qsort()".
  169.  * Es wird der Reihe nach fuer jedes Element ausser dem letzten das
  170.  * Minimum von diesem Element und allen rechts von ihm stehenden
  171.  * Elementen gesucht, und dann das Element und das Minimum ausgetauscht.
  172.  *)
  173. VAR __REG__ i    : UNSIGNEDWORD;
  174.     __REG__ j    : UNSIGNEDWORD;
  175.     __REG__ min  : UNSIGNEDWORD;
  176.     __REG__ tmp  : UNSIGNEDLONG;
  177.  
  178. BEGIN
  179.  FOR i := from TO to - 1 DO
  180.    min := i;
  181.    FOR j := i + 1 TO to DO
  182.      IF buf[j] < buf[min] THEN
  183.        min := j;
  184.      END;
  185.    END;
  186.    IF i <> min THEN
  187.      tmp      := buf[i];
  188.      buf[i]   := buf[min];
  189.      buf[min] := tmp;
  190.    END;
  191.  END;
  192. END SlowSort;
  193.  
  194. (*---------------------------------------------------------------------------*)
  195.  
  196. PROCEDURE tmemchr ((* EIN/ -- *) REF proc : ARRAY OF CHAR );
  197.  
  198. CONST MEMSIZE = 10020H; (* > 64kB *)
  199.  
  200. TYPE CHARPTR = POINTER TO CHAR;
  201.  
  202. VAR mem  : CHARPTR;
  203.     res  : INTEGER;
  204.     void : BOOLEAN;
  205.  
  206. PROCEDURE test (offset : UNSIGNEDLONG; len : UNSIGNEDLONG; exp : CHARPTR): BOOLEAN;
  207. VAR tmp1 : CHARPTR;
  208.     tmp2 : CHARPTR;
  209. BEGIN
  210.  tmp1  := ADDADR(mem, offset);
  211.  tmp1^ := CPATTERN;
  212.  tmp2  := memchr(mem, ORD(CPATTERN), len);
  213.  tmp1^ := 0C;
  214.  RETURN(tmp2 = exp);
  215. END test;
  216.  
  217. BEGIN
  218.  IF Malloc(MEMSIZE, mem) THEN
  219.    WriteString(proc); Write(' ');
  220.    memset(mem, 0, MEMSIZE); (* Annahme: "memset()" funktioniert *)
  221.    (* Ein paar Stichproben an den Raendern genuegen *)
  222.    IF NOT test(0, 0, NULL) THEN
  223.      WriteString("*** 1");
  224.      RETURN;
  225.    END;
  226.    IF NOT test(0, 1, mem) THEN
  227.      WriteString("*** 2");
  228.      RETURN;
  229.    END;
  230.    IF NOT test(1, 1, NULL) THEN
  231.      WriteString("*** 3");
  232.      RETURN;
  233.    END;
  234.    IF NOT test(1, 10, CAST(CHARPTR,ADDADR(mem, 1))) THEN
  235.      WriteString("*** 4");
  236.      RETURN;
  237.    END;
  238.    IF NOT test(10000H, 10000H, NULL) THEN
  239.      WriteString("*** 5");
  240.      RETURN;
  241.    END;
  242.    IF NOT test(10000H, 10001H, CAST(CHARPTR,ADDADR(mem, 10000H))) THEN
  243.      WriteString("*** 6");
  244.      RETURN;
  245.    END;
  246.    IF NOT test(10010H, 10010H, NULL) THEN
  247.      WriteString("*** 7");
  248.      RETURN;
  249.    END;
  250.    IF NOT test(10010H, 10011H, CAST(CHARPTR,ADDADR(mem, 10010H))) THEN
  251.      WriteString("*** 8");
  252.      RETURN;
  253.    END;
  254.    void := Mfree(mem, res);
  255.    WriteString("OK");
  256.    WriteLn;
  257.  END;
  258. END tmemchr;
  259.  
  260. (*---------------------------------------------------------------------------*)
  261.  
  262. PROCEDURE tmemswap ((* EIN/ -- *) REF proc   : ARRAY OF CHAR;
  263.                     (* EIN/ -- *)     blk1   : SIGNEDWORD;
  264.                     (* EIN/ -- *)     blk2   : SIGNEDWORD;
  265.                     (* EIN/ -- *)     maxlen : SIGNEDWORD );
  266.  
  267. VAR __REG__ len : SIGNEDWORD;
  268.     __REG__ i   : SIGNEDWORD;
  269.  
  270. PROCEDURE WriteMsg (i, len : SIGNEDWORD; exp : CHAR; REF msg : ARRAY OF CHAR);
  271. BEGIN
  272.  ClearBusy;
  273.  WriteLn;
  274.  WriteString(msg); WriteLn;
  275.  WriteString("blk1: "); WriteInt(INT(blk1), 0); WriteLn;
  276.  WriteString("blk2: "); WriteInt(INT(blk2), 0); WriteLn;
  277.  WriteString(" len: "); WriteInt(INT(len), 0); WriteLn;
  278.  WriteString("cbuf["); WriteInt(INT(i), 0); WriteString("]: ");
  279.  WriteInt(INT(cbuf[i]),0); WriteString(" (expected: ");
  280.  WriteInt(INT(exp),0); Write(')');
  281.  WriteLn;
  282.  Read(ch);
  283. END WriteMsg;
  284.  
  285.  
  286. BEGIN
  287.  WriteString(proc); Write(' ');
  288.  FOR len := 0 TO maxlen DO
  289.    Busy;
  290.    FOR i := 0 TO MAXCBUF DO
  291.      cbuf[i] := 0C;
  292.    END;
  293.    FOR i := blk1 TO blk1+len-1 DO
  294.      cbuf[i] := CHR(i);
  295.    END;
  296.    FOR i := blk2 TO blk2+len-1 DO
  297.      cbuf[i] := CHR(i);
  298.    END;
  299.    memswap(ADR(cbuf[blk1]), ADR(cbuf[blk2]), VAL(UNSIGNEDLONG,len));
  300.    FOR i := 0 TO blk1-1 DO
  301.      IF cbuf[i] <> 0C THEN
  302.        WriteMsg(i, len, 0C,"*** cbuf[i=0..blk1-1]:");
  303.        RETURN;
  304.      END;
  305.    END;
  306.    FOR i := blk1 TO blk1+len-1 DO
  307.      (* Steht Block2 an der Stelle des ehemaligen Block1? *)
  308.      IF cbuf[i] <> CHR(blk2+i-blk1) THEN
  309.        WriteMsg(i, len, CHR(blk2+i-blk1),"*** cbuf[i=blk1..blk1+len-1]:");
  310.        RETURN;
  311.      END;
  312.    END;
  313.    FOR i := blk1+len TO blk2-1 DO
  314.      IF cbuf[i] <> 0C THEN
  315.        WriteMsg(i, len, 0C,"*** cbuf[i=blk1+len..blk2-1]:");
  316.        RETURN;
  317.      END;
  318.    END;
  319.    FOR i := blk2 TO blk2+len-1 DO
  320.      (* Steht Block1 an der Stelle des ehemaligen Block2? *)
  321.      IF cbuf[i] <> CHR(blk1+i-blk2) THEN
  322.        WriteMsg(i, len, CHR(blk1+i-blk2),"*** cbuf[i=blk2..blk2+len-1]:");
  323.        RETURN;
  324.      END;
  325.    END;
  326.    FOR i := blk2+len TO MAXCBUF DO
  327.      IF cbuf[i] <> 0C THEN
  328.        WriteMsg(i, len, 0C,"*** cbuf[i=blk2+len..CMAXBUF]:");
  329.        RETURN;
  330.      END;
  331.    END;
  332.  END;
  333.  ClearBusy;
  334.  WriteString("OK");
  335.  WriteLn;
  336. END tmemswap;
  337.  
  338. (*---------------------------------------------------------------------------*)
  339.  
  340. PROCEDURE tmemcmp ((* EIN/ -- *) REF proc   : ARRAY OF CHAR;
  341.                    (* EIN/ -- *)     blk1   : SIGNEDWORD;
  342.                    (* EIN/ -- *)     blk2   : SIGNEDWORD;
  343.                    (* EIN/ -- *)     maxlen : SIGNEDWORD );
  344.  
  345. VAR __REG__ len : SIGNEDWORD;
  346.     __REG__ i   : SIGNEDWORD;
  347.             res : INTEGER;
  348.  
  349. PROCEDURE WriteMsg (len : SIGNEDWORD; REF exp : ARRAY OF CHAR);
  350. BEGIN
  351.  ClearBusy;
  352.  WriteLn;
  353.  WriteString("**********"); WriteLn;
  354.  WriteString("blk1: "); WriteInt(INT(blk1), 0); WriteLn;
  355.  WriteString("blk2: "); WriteInt(INT(blk2), 0); WriteLn;
  356.  WriteString(" len: "); WriteInt(INT(len), 0); WriteLn;
  357.  WriteString("cmp: "); WriteInt(res, 0);
  358.  WriteString(" (expected: "); WriteString(exp); Write(')');
  359.  WriteLn;
  360.  Read(ch);
  361. END WriteMsg;
  362.  
  363.  
  364. BEGIN
  365.  WriteString(proc); Write(' ');
  366.  FOR len := 0 TO maxlen DO
  367.    Busy;
  368. (* Test auf = *)
  369.    FOR i := blk1 TO blk1+len-1 DO
  370.      cbuf[i] := CHR(10);;
  371.    END;
  372.    cbuf[blk1+len] := CHR(11);
  373.    FOR i := blk2 TO blk2+len-1 DO
  374.      cbuf[i] := CHR(10);
  375.    END;
  376.    cbuf[blk2+len] := CHR(9);
  377.    res := memcmp(ADR(cbuf[blk1]), ADR(cbuf[blk2]), VAL(UNSIGNEDLONG,len));
  378.    IF res <> 0 THEN
  379.      WriteMsg(len, "= 0");
  380.      RETURN;
  381.    END;
  382.    IF len > 0 THEN
  383. (* Test auf < *)
  384.      FOR i := blk1 TO blk1+len-2 DO
  385.        cbuf[i] := CHR(10);;
  386.      END;
  387.      cbuf[blk1+len-1] := CHR(9);
  388.      FOR i := blk2 TO blk2+len-2 DO
  389.        cbuf[i] := CHR(10);
  390.      END;
  391.      cbuf[blk2+len-1] := CHR(11);
  392.      res := memcmp(ADR(cbuf[blk1]), ADR(cbuf[blk2]), VAL(UNSIGNEDLONG,len));
  393.      IF res >= 0 THEN
  394.        WriteMsg(len, "< 0");
  395.        RETURN;
  396.      END;
  397. (* Test auf > *)
  398.      FOR i := blk1 TO blk1+len-2 DO
  399.        cbuf[i] := CHR(10);;
  400.      END;
  401.      cbuf[blk1+len-1] := CHR(11);
  402.      FOR i := blk2 TO blk2+len-2 DO
  403.        cbuf[i] := CHR(10);
  404.      END;
  405.      cbuf[blk2+len-1] := CHR(9);
  406.      res := memcmp(ADR(cbuf[blk1]), ADR(cbuf[blk2]), VAL(UNSIGNEDLONG,len));
  407.      IF res <= 0 THEN
  408.        WriteMsg(len, "> 0");
  409.        RETURN;
  410.      END;
  411.    END;
  412.  END;
  413.  ClearBusy;
  414.  WriteString("OK");
  415.  WriteLn;
  416. END tmemcmp;
  417.  
  418. (*---------------------------------------------------------------------------*)
  419.  
  420. PROCEDURE tmemset ((* EIN/ -- *) REF proc   : ARRAY OF CHAR;
  421.                    (* EIN/ -- *)     from   : SIGNEDWORD;
  422.                    (* EIN/ -- *)     maxlen : SIGNEDWORD    );
  423.  
  424. VAR __REG__ len : SIGNEDWORD;
  425.     __REG__ i   : SIGNEDWORD;
  426.  
  427. PROCEDURE WriteMsg (i, len: SIGNEDWORD; exp : CHAR; REF msg : ARRAY OF CHAR);
  428. BEGIN
  429.  ClearBusy;
  430.  WriteLn;
  431.  WriteString(msg); WriteLn;
  432.  WriteString("from: "); WriteInt(INT(from), 0); WriteLn;
  433.  WriteString(" len: "); WriteInt(INT(len), 0); WriteLn;
  434.  WriteString("cbuf["); WriteInt(INT(i), 0); WriteString("]: ");
  435.  WriteInt(INT(cbuf[i]),0); WriteString(" (expected: ");
  436.  WriteInt(INT(exp),0); Write(')');
  437.  WriteLn;
  438.  Read(ch);
  439. END WriteMsg;
  440.  
  441. BEGIN
  442.  WriteString(proc); Write(' ');
  443.  FOR len := 0 TO maxlen DO
  444.    Busy;
  445.    FOR i := 0 TO MAXCBUF DO
  446.      cbuf[i] := CPATTERN;
  447.    END;
  448.    memset(ADR(cbuf[from]), 5, VAL(UNSIGNEDLONG,len));
  449.    FOR i := 0 TO from-1 DO
  450.      IF cbuf[i] <> CPATTERN THEN
  451.        WriteMsg(i, len, CPATTERN,"*** cbuf[i=0..from-1]:");
  452.        RETURN;
  453.      END;
  454.    END;
  455.    FOR i := from TO from+len-1 DO
  456.      IF cbuf[i] <> 5C THEN
  457.        WriteMsg(i, len, 5C,"*** cbuf[i=from..from+len-1]:");
  458.        RETURN;
  459.      END;
  460.    END;
  461.    FOR i := from+len TO MAXCBUF DO
  462.      IF cbuf[i] <> CPATTERN THEN
  463.        WriteMsg(i, len, CPATTERN,"*** cbuf[i=from+len..MAXCBUF]:");
  464.        RETURN;
  465.      END;
  466.    END;
  467.  END;
  468.  ClearBusy;
  469.  WriteString("OK");
  470.  WriteLn;
  471. END tmemset;
  472.  
  473. (*---------------------------------------------------------------------------*)
  474.  
  475. PROCEDURE tmemmove ((* EIN/ -- *) REF proc    : ARRAY OF CHAR;
  476.                     (* EIN/ -- *)     from    : SIGNEDWORD;
  477.                     (* EIN/ -- *)     to      : SIGNEDWORD;
  478.                     (* EIN/ -- *)     maxlen  : SIGNEDWORD );
  479.  
  480. VAR __REG__ len       : SIGNEDWORD;
  481.     __REG__ i         : SIGNEDWORD;
  482.             high, low : SIGNEDWORD;
  483.             min, max  : SIGNEDWORD;
  484.             dist      : SIGNEDWORD;
  485.  
  486. PROCEDURE WriteMsg (i, len : SIGNEDWORD; exp : CHAR; REF msg : ARRAY OF CHAR);
  487. BEGIN
  488.  ClearBusy;
  489.  WriteLn;
  490.  WriteString(msg); WriteLn;
  491.  WriteString("from: "); WriteInt(INT(from), 0); WriteLn;
  492.  WriteString("  to: "); WriteInt(INT(to), 0); WriteLn;
  493.  WriteString(" len: "); WriteInt(INT(len), 0); WriteLn;
  494.  WriteString("cbuf["); WriteInt(INT(i), 0); WriteString("]: ");
  495.  WriteInt(INT(cbuf[i]),0); WriteString(" (expected: ");
  496.  WriteInt(INT(exp),0); Write(')');
  497.  WriteLn;
  498.  Read(ch);
  499. END WriteMsg;
  500.  
  501. BEGIN
  502.  WriteString(proc); Write(' ');
  503.  dist := ABS(from - to);
  504.  FOR len := 0 TO maxlen DO
  505.    Busy;
  506.    FOR i := 0 TO MAXCBUF DO
  507.      cbuf[i] := 0C;
  508.    END;
  509.    FOR i := from TO from+len-1 DO
  510.      cbuf[i] := CHR(i);
  511.    END;
  512.    memmove(ADR(cbuf[to]), ADR(cbuf[from]), VAL(UNSIGNEDLONG,len));
  513.    IF from <= to THEN
  514.      low  := from;
  515.      high := to;
  516.      min  := from;
  517.      (* Maximale Anzahl von Elementen, die noch im Quellbereich stehen *)
  518.      IF dist < len THEN
  519.        (* Zielbereich ueberlappt den oberen Teil des Quellbereichs,
  520.         * es sind noch soviele Elemente des Quellbereichs erhalten
  521.         * wie die beiden Bereich auseinander sind.
  522.         *)
  523.        max := dist;
  524.      ELSE
  525.        (* Keine Ueberlappung, also ist der volle Quellbereich erhalten *)
  526.        max := len;
  527.      END;
  528.    ELSE
  529.      low  := to;
  530.      high := from;
  531.      max  := len;
  532.      (* Kleinster Index, an dem noch Elemente des Quellbereichs stehen *)
  533.      IF dist < len THEN
  534.        (* Zielbereich ueberlappt den unteren Teil des Quellbereichs,
  535.         * erst nach dem Ende des Zielbereichs stehen die restlichen
  536.         * Elemente des Quellbereichs.
  537.         *)
  538.        min := to + len
  539.      ELSE
  540.        (* Keine Ueberlappung, also ist der volle Quellbereich erhalten *)
  541.        min := from;
  542.      END;
  543.    END;
  544.    FOR i := 0 TO low-1 DO
  545.      IF cbuf[i] <> 0C THEN
  546.        WriteMsg(i, len, 0C,"*** cbuf[i=0..low-1]:");
  547.        RETURN;
  548.      END;
  549.    END;
  550.    FOR i := min TO from+max-1 DO
  551.      (* Quellbereich (teilweise) erhalten? *)
  552.      IF cbuf[i] <> CHR(i) THEN
  553.        WriteMsg(i, len, CHR(i),"*** cbuf[i=min..from+max-1]:");
  554.        RETURN;
  555.      END;
  556.    END;
  557.    FOR i := low+len TO high-1 DO
  558.      IF cbuf[i] <> 0C THEN
  559.        WriteMsg(i, len, 0C,"*** cbuf[i=low+len..high-1]:");
  560.        RETURN;
  561.      END;
  562.    END;
  563.    FOR i := to TO to+len-1 DO
  564.      (* Enthaelt der Zielbereich den Quellbereich? *)
  565.      IF cbuf[i] <> CHR(from+i-to) THEN
  566.        WriteMsg(i, len, CHR(from+i-to),"*** cbuf[i=to..to+len-1]:");
  567.        RETURN;
  568.      END;
  569.    END;
  570.    FOR i := high+len TO MAXCBUF DO
  571.      IF cbuf[i] <> 0C THEN
  572.        WriteMsg(i, len, 0C,"*** cbuf[i=high+len..MAXCBUF]:");
  573.        RETURN;
  574.      END;
  575.    END;
  576.  END;
  577.  ClearBusy;
  578.  WriteString("OK");
  579.  WriteLn;
  580. END tmemmove;
  581.  
  582. (*---------------------------------------------------------------------------*)
  583.  
  584. PROCEDURE tltoa ((* EIN/ -- *) REF proc     : ARRAY OF CHAR;
  585.                  (* EIN/ -- *)     val      : UNSIGNEDLONG;
  586.                  (* EIN/ -- *)     base     : CARDINAL;
  587.                  (* EIN/ -- *)     signed   : BOOLEAN;
  588.                  (* EIN/ -- *) REF expected : ARRAY OF CHAR );
  589. BEGIN
  590.  IF signed THEN
  591.    ltoa(CAST(SIGNEDLONG,val), cbuf, base);
  592.  ELSE
  593.    ultoa(val, cbuf, base);
  594.  END;
  595.  IF NOT EQUAL(cbuf, expected) THEN
  596.    WriteString(proc);
  597.    WriteString(": expected: '");
  598.    WriteString(expected);
  599.    WriteString("', got: '");
  600.    WriteString(cbuf);
  601.    WriteString("'.");
  602.    WriteLn;
  603.    ERROR := TRUE;
  604.  END;
  605. END tltoa;
  606.  
  607. (*---------------------------------------------------------------------------*)
  608.  
  609. PROCEDURE tqsort ((* EIN/ -- *) REF proc   : ARRAY OF CHAR;
  610.                   (* EIN/ -- *)     maxlen : SIGNEDWORD;
  611.                   (* EIN/ -- *)     fill   : FillProc   );
  612.  
  613. VAR __REG__ len : SIGNEDWORD;
  614.     __REG__ i   : SIGNEDWORD;
  615.  
  616. PROCEDURE WriteMsg (i, len : SIGNEDWORD; REF msg : ARRAY OF CHAR);
  617. BEGIN
  618.  ClearBusy;
  619.  WriteLn;
  620.  WriteString(msg); WriteLn;
  621.  WriteString("BEFORE: "); WriteInt(BEFORE, 0); WriteLn;
  622.  WriteString(" AFTER: "); WriteInt(AFTER, 0); WriteLn;
  623.  WriteString("   len: "); WriteInt(len, 0); WriteLn;
  624.  WriteString("lbuf["); WriteInt(i, 0); WriteString("]: ");
  625.  WriteInt(INT(lbuf[i]), 0); WriteString(" (expected: ");
  626.  WriteInt(INT(lbuf2[i]), 0); Write(')');
  627.  WriteLn;
  628.  Read(ch);
  629. END WriteMsg;
  630.  
  631. BEGIN
  632.  WriteString(proc); Write(' ');
  633.  FOR len := 0 TO maxlen DO
  634.    Busy;
  635.    FOR i := 0 TO BEFORE-1 DO
  636.      lbuf[i] := VAL(UNSIGNEDLONG,i);
  637.    END;
  638.    FOR i := 0 TO len - 1 DO
  639.      lbuf[i+BEFORE] := fill(i, len);
  640.    END;
  641.    FOR i:=0 TO AFTER-1 DO
  642.      lbuf[i+len+BEFORE] := VAL(UNSIGNEDLONG,i);
  643.    END;
  644.    FOR i := BEFORE+len+AFTER TO MAXLBUF DO
  645.      lbuf[i] := LPATTERN;
  646.    END;
  647.    lbuf2 := lbuf;
  648.    SlowSort(BEFORE, BEFORE+len-1, lbuf2);
  649.    qsort(ADR(lbuf[BEFORE]), VAL(UNSIGNEDLONG,len), VAL(UNSIGNEDLONG,TSIZE(UNSIGNEDLONG)), cmp);
  650.    FOR i:=0 TO BEFORE-1 DO
  651.      IF lbuf[i] <> VAL(UNSIGNEDLONG,i) THEN
  652.        WriteMsg(i, len, "*** lbuf[i=0..BEFORE-1]:");
  653.        RETURN;
  654.      END;
  655.    END;
  656.    FOR i:=BEFORE TO BEFORE+len-1 DO
  657.      IF lbuf[i] <> lbuf2[i] THEN
  658.        WriteMsg(i, len, "*** lbuf[i=BEFORE..BEFORE+len-1]:");
  659.        RETURN;
  660.      END;
  661.    END;
  662.    FOR i:=BEFORE+len TO BEFORE+len+AFTER-1 DO
  663.      IF lbuf[i] <> VAL(UNSIGNEDLONG,i-len-BEFORE) THEN
  664.        WriteMsg(i, len, "*** lbuf[i=BEFORE+len..BEFORE+len+AFTER-1]:");
  665.        RETURN;
  666.      END;
  667.    END;
  668.    FOR i := BEFORE+len+AFTER TO MAXLBUF DO
  669.      IF lbuf[i] <> LPATTERN THEN
  670.        WriteMsg(i, len, "*** lbuf[i=BEFORE+len+AFTER..MAXLBUF]:");
  671.        RETURN;
  672.      END;
  673.    END;
  674.  END;
  675.  ClearBusy;
  676.  WriteString("OK");
  677.  WriteLn;
  678. END tqsort;
  679.  
  680. (*---------------------------------------------------------------------------*)
  681.  
  682. PROCEDURE initsearch;
  683. VAR __REG__ i : SIGNEDWORD;
  684. BEGIN
  685.  FOR i:=0 TO BEFORE-1 DO
  686.    lbuf[i] := 0;
  687.  END;
  688.  FOR i:=BEFORE TO BEFORE+MAXLEN-1 DO
  689.    lbuf[i] := VAL(UNSIGNEDLONG,i+i);
  690.  END;
  691.  FOR i:=BEFORE+MAXLEN TO BEFORE+MAXLEN+AFTER-1 DO
  692.    lbuf[i] := (BEFORE+MAXLEN)*2+AFTER;
  693.  END;
  694. END initsearch;
  695.  
  696. (*---------------------------------------------------------------------------*)
  697.  
  698. PROCEDURE tsearch ((* EIN/ -- *) REF proc     : ARRAY OF CHAR;
  699.                    (* EIN/ -- *)     bin      : BOOLEAN;
  700.                    (* EIN/ -- *)     element  : UNSIGNEDLONG;
  701.                    (* EIN/ -- *)     expected : ADDRESS      );
  702.  
  703. VAR place : ADDRESS;
  704.  
  705. BEGIN
  706.  IF bin THEN
  707.    place := bsearch(ADR(element), ADR(lbuf[BEFORE]), MAXLEN, 4, cmp);
  708.  ELSE
  709.    place := lfind(ADR(element), ADR(lbuf[BEFORE]), MAXLEN, 4, cmp);
  710.  END;
  711.  IF place <> expected THEN
  712.    ultoa(CAST(UNSIGNEDLONG,expected), cbuf, 16);
  713.    WriteString(proc);
  714.    WriteString(": expected: '$");
  715.    WriteString(cbuf);
  716.    WriteString("', got: '$");
  717.    ultoa(CAST(UNSIGNEDLONG,place), cbuf, 16);
  718.    WriteString(cbuf);
  719.    WriteString("'.");
  720.    WriteLn;
  721.    ERROR := TRUE;
  722.  END;
  723. END tsearch;
  724.  
  725. (*---------------------------------------------------------------------------*)
  726.  
  727. PROCEDURE action;
  728. BEGIN
  729.  WriteString("action ");
  730.  longjmp(jmpbuf, LONGJUMPVAL);
  731. END action;
  732.  
  733. (*---------------------------------------------------------------------------*)
  734.  
  735. PROCEDURE tjump;
  736.  
  737. VAR localvar : UNSIGNEDLONG;
  738.     jumped   : BOOLEAN;
  739.     val      : INTEGER;
  740.  
  741. BEGIN
  742.  jumped   := FALSE;
  743.  localvar := LOCALVAL;
  744.  
  745.  val := setjmp(jmpbuf);
  746.  IF val = 0 THEN
  747.    WriteString("setjmp ");
  748.    action;
  749.  ELSE
  750.    WriteString("longjmp ");
  751.    jumped := TRUE;
  752.  END;
  753.  IF    jumped                   (* Ruecksprungadresse OK ? *)
  754.    AND (val       = LONGJUMPVAL)(* Funktionswert OK ? *)
  755.    AND (globalvar = GLOBALVAL)  (* Zeiger auf globale Var. OK ? *)
  756.    AND (localvar  = LOCALVAL)   (* Zeiger auf lokale Var. OK ? *)
  757.  THEN
  758.    WriteString("OK");
  759.  ELSE
  760.    (* Wohl eher Absturz... *)
  761.    WriteString("**failed**");
  762.  END;
  763.  WriteLn;
  764. END tjump;
  765.  
  766. (*---------------------------------------------------------------------------*)
  767.  
  768. PROCEDURE talloc;
  769.  
  770. CONST ALLOCSIZE = 256;
  771.  
  772. VAR sp1   : ADDRESS;
  773.     sp2   : ADDRESS;
  774.     old1  : ADDRESS;
  775.     old2  : ADDRESS;
  776.     res1  : ADDRESS;
  777.     res2  : ADDRESS;
  778.  
  779.  
  780. BEGIN
  781.  WriteString("memalloc: ");
  782.  GETREGADR(15, sp1);
  783.  memalloc(ALLOCSIZE, old1, res1);
  784.  ERROR := (sp1 <> old1) OR (SUBADR(sp1, ALLOCSIZE) <> res1);
  785.  GETREGADR(15, sp2);
  786.  ERROR := ERROR OR (sp2 <> res1);
  787.  
  788.  memalloc(ALLOCSIZE, old2, res2);
  789.  ERROR := ERROR OR (sp2 <> old2) OR (SUBADR(sp2, ALLOCSIZE) <> res2);
  790.  GETREGADR(15, sp2);
  791.  ERROR := ERROR OR (sp2 <> res2);
  792.  IF ERROR THEN
  793.    WriteString("**failed**");
  794.  ELSE
  795.    WriteString("OK"); WriteLn;
  796.    WriteString("memdealloc: ");
  797.    memdealloc(old1);
  798.    GETREGADR(15, sp2);
  799.    IF sp1 <> sp2 THEN
  800.      WriteString("**failed**");
  801.    ELSE
  802.      WriteString("OK");
  803.    END;
  804.    WriteLn;
  805.  END;
  806.  WriteLn;
  807. END talloc;
  808.  
  809. (*===========================================================================*)
  810.  
  811. BEGIN
  812.  BusyBuf   := "-\|/";
  813.  BusyIdx   := 0;
  814.  globalvar := GLOBALVAL;
  815.  
  816.  
  817.  tmemmove("memmove[SRC < DST, EVEN->EVEN]: ", 200 ,230, 60);
  818.  tmemmove("memmove[SRC < DST, EVEN->ODD]: ", 200, 231, 60);
  819.  tmemmove("memmove[SRC < DST, ODD->EVEN]: ", 201, 230, 60);
  820.  tmemmove("memmove[SRC < DST, ODD->ODD]: ", 201, 231, 60);
  821.  tmemmove("memmove[SRC > DST, EVEN->EVEN]: ", 230, 200, 60);
  822.  tmemmove("memmove[SRC > DST, EVEN->ODD]: ", 230, 201, 60);
  823.  tmemmove("memmove[SRC > DST, ODD->EVEN]: ", 231, 200, 60);
  824.  tmemmove("memmove[SRC > DST, ODD->ODD]: ", 231, 201, 60);
  825.  
  826.  tmemset("memset[EVEN]: ", 200, 60);
  827.  tmemset("memset[ODD]: ", 201, 60);
  828.  
  829.  tmemswap("memswap[EVEN -> EVEN]: ", 200, 300, 60);
  830.  tmemswap("memswap[EVEN -> ODD]: ", 200, 301, 60);
  831.  tmemswap("memswap[ODD -> EVEN]: ", 201, 300, 60);
  832.  tmemswap("memswap[ODD -> ODD]: ", 201, 301, 60);
  833.  
  834.  tmemchr("memchr: ");
  835.  
  836.  tmemcmp("memcmp[EVEN -> EVEN]: ", 200, 300, 60);
  837.  tmemcmp("memcmp[EVEN -> ODD]: ", 200, 301, 60);
  838.  tmemcmp("memcmp[ODD -> EVEN]: ", 201, 300, 60);
  839.  tmemcmp("memcmp[ODD -> ODD]: ", 201, 301, 60);
  840.  
  841.  tqsort("qsort[INC]: ", MAXLEN, fillinc); (* bereits aufsteigend sortiertes Feld *)
  842.  tqsort("qsort[DEC]: ", MAXLEN, filldec); (* bereits absteigend sortiertes Feld *)
  843.  tqsort("qsort[RND]: ", MAXLEN, fillrnd); (* Zufallszahlen *)
  844.  
  845.  
  846.  ERROR := FALSE;
  847.  tltoa("ltoa", 0, 10, TRUE, "0");
  848.  tltoa("ltoa", MAXLINT, 10, TRUE, "2147483647");
  849.  tltoa("ltoa", MAXLINT, 16, TRUE, "7FFFFFFF");
  850.  tltoa("ltoa", MINLINT, 10, TRUE, "-2147483648");
  851.  tltoa("ltoa", MINLINT, 16, TRUE, "80000000");
  852.  tltoa("ltoa", MAXLCARD, 10, TRUE, "-1");
  853.  tltoa("ltoa", MAXLCARD, 16, TRUE, "FFFFFFFF");
  854.  OK("ltoa");
  855.  
  856.  ERROR := FALSE;
  857.  tltoa("ultoa", 0, 10, FALSE, "0");
  858.  tltoa("ultoa", MAXLINT, 10, FALSE, "2147483647");
  859.  tltoa("ultoa", MAXLINT, 16, FALSE, "7FFFFFFF");
  860.  tltoa("ultoa", MINLINT, 10, FALSE, "2147483648");
  861.  tltoa("ultoa", MINLINT, 16, FALSE, "80000000");
  862.  tltoa("ultoa", MAXLCARD, 10, FALSE, "4294967295");
  863.  tltoa("ultoa", MAXLCARD, 16, FALSE, "FFFFFFFF");
  864.  OK("ultoa");
  865.  
  866.  initsearch;
  867.  ERROR := FALSE;
  868.  tsearch("bsearch", TRUE, 0, NULL); (* vor dem Feld *)
  869.  tsearch("bsearch", TRUE, (BEFORE+5)*2, ADR(lbuf[BEFORE+5])); (* gerade Zahl *)
  870.  tsearch("bsearch", TRUE, (BEFORE+5)*2+1, NULL); (* ungerade Zahl *)
  871.  tsearch("bsearch", TRUE, (BEFORE+MAXLEN)*2+AFTER, NULL); (* hinter dem Feld *)
  872.  OK("bsearch");
  873.  
  874.  ERROR := FALSE;
  875.  tsearch("lfind", FALSE, 0, NULL); (* vor dem Feld *)
  876.  tsearch("lfind", FALSE, (BEFORE+5)*2, ADR(lbuf[BEFORE+5])); (* gerade Zahl *)
  877.  tsearch("lfind", FALSE, (BEFORE+5)*2+1, NULL); (* ungerade Zahl *)
  878.  tsearch("lfind", FALSE, (BEFORE+MAXLEN)*2+AFTER, NULL); (* hinter dem Feld *)
  879.  OK("lfind");
  880.  
  881.  tjump;
  882.  
  883.  talloc;
  884.  
  885.  Read(ch);
  886. END Tlib.
  887.